home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / source / emacs-18.59src.lha / emacs-18.59 / amiga / contrib / schinz / functions.el
Encoding:
Text File  |  1993-05-08  |  3.7 KB  |  89 lines
  1. ;; Code contributed by :
  2. ;;   Michel Schinz     | INTERNET: Week-end: schinz@guano.alphanet.ch
  3. ;;   Epinettes 10a     |           Week    : schinz@di.epfl.ch
  4. ;;   CH-2013 COLOMBIER | FIDONET:  2:302/562 (Michel Schinz)
  5.  
  6.  
  7.    (defun amiga-arexx-add-lib (lib entry)
  8.      "Adds the specified ARexx library, with given entry point."
  9.      (interactive "sLibrary name: \nnOffset: ")
  10.      (amiga-arexx-do-command (concat "CALL ADDLIB('" lib "',0," entry ")") t))
  11.  
  12.    (defun amiga-reqtools-find-file ()
  13.      "Like find-file, but with RexxReqTools' file requester."
  14.      (interactive)
  15.      (amiga-arexx-add-lib "rexxreqtools.library" -30)
  16.      (amiga-arexx-do-command (concat "f = rtFileRequest('" default-directory
  17.                      "',,'Find file')\n"
  18.                      "IF f ~= '' THEN"
  19.                      "   '(find-file \"'||f||'\")'") t))
  20.  
  21.    (defun amiga-reqtools-insert-file ()
  22.      "Like insert-file, but with RexxReqTools' file requester."
  23.      (interactive)
  24.      (amiga-arexx-add-lib "rexxreqtools.library" -30)
  25.      (amiga-arexx-do-command (concat "f = rtFileRequest('" default-directory
  26.                      "',,'Insert file')\n"
  27.                      "IF f ~= '' THEN"
  28.                      "   '(insert-file \"'||f||'\")'") t))
  29.  
  30.    (defun amiga-reqtools-write-file ()
  31.      "Like write-file, but with RexxReqTools' file requester."
  32.      (interactive)
  33.      (let ((dir (file-name-directory buffer-file-name))
  34.        (file (file-name-nondirectory buffer-file-name)))
  35.        (amiga-arexx-add-lib "rexxreqtools.library" -30)
  36.        (amiga-arexx-do-command (concat "f = rtFileRequest('" dir "','" file
  37.                        "','Write file',,"
  38.                        "'rtfi_flags=freqf_save')\n"
  39.                        "IF f ~= '' THEN"
  40.                        "   '(write-file \"'||f||'\")'") t)))
  41.  
  42.    ;;; amiga-update-version-string
  43.    ;;; Michel Schinz
  44.    ;;; $VER: amiga_verstring.el 1.0 (7.05.1993)
  45.  
  46.    (defun amiga-update-version-string ()
  47.      "Create/update a version string (CBM style) on the current line.
  48.    If no version string is present on the current line, create a new one
  49.    that looks like `$VER: <buffer-name> 1.0 (<current_date>)' at the
  50.    point position. If a version string is already present on the current
  51.    line, the date is ... updated and the revision is incremented.
  52.    Please note that currently, no spaces are allowed in the `name' field."
  53.      (interactive)
  54.      (save-excursion
  55.        (let (end-of-line-pos
  56.          name version revision date
  57.          (old-point-pos (point-marker)))
  58.      (let* ((date-string (current-time-string))
  59.         (garbage (string-match
  60.               " \\([A-Z][a-z][a-z]\\) *\\([0-9]*\\) .* \\([0-9]*\\)$"
  61.               date-string))
  62.         (day (substring date-string (match-beginning 2) (match-end 2)))
  63.         (month
  64.          (cdr (assoc
  65.                (substring date-string (match-beginning 1) (match-end 1))
  66.                '(("Jan" . "01") ("Feb" . "02") ("Mar" . "03") ("Apr" . "04")
  67.              ("May" . "05") ("Jun" . "06") ("Jul" . "07") ("Aug" . "08")
  68.              ("Sep" . "09") ("Oct" . "10") ("Nov" . "11") ("Dec" . "12")))))
  69.         (year (substring date-string (match-beginning 3) (match-end 3))))
  70.        (setq date (concat day "." month "." year)))
  71.      (end-of-line)
  72.      (setq end-of-line-pos (point))
  73.      (beginning-of-line)
  74.      (if (search-forward "$VER: " end-of-line-pos t)
  75.          (let ((start-of-version-string (- (point) 6)))
  76.            (re-search-forward
  77.         " *\\([^ ]*\\) *\\([0-9]*\\)\.\\([0-9]*\\) *([0-9.]*)" end-of-line-pos t)
  78.            (setq name (buffer-substring (match-beginning 1) (match-end 1))
  79.              version (buffer-substring (match-beginning 2) (match-end 2))
  80.              revision (+ 1 (string-to-int
  81.                     (buffer-substring (match-beginning 3) (match-end 3)))))
  82.            (delete-region start-of-version-string (point)))
  83.        (progn (setq name (file-name-nondirectory (buffer-name))
  84.             version 1
  85.             revision 0)
  86.           (goto-char old-point-pos)))
  87.      (insert (concat "$VER: " name " " version "." revision " (" date ")")))))
  88.  
  89.